perm filename REFACE[GEO,BGB] blob
sn#085232 filedate 1974-01-31 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 TITLE REFACE
C00007 00003 SUBR(REFACE,BODY,NUMBER) MAKE N CUTS ALONG Z AXIS.
C00010 00004 SUBN(BOUNDS,BODY) MAKE BOUNDS CUBE.
C00012 00005 SUBR(SLICE0,BDYSET) SLICE A SET OF BODIES AT ZCUT LEVEL.
C00015 00006 SUBN(VMARK,BODY) MARK THE VERTICES OF A BODY AS PZ OR NZ.
C00017 00007 SUBN(FECUT,BODY) FACE EDGE CUTTING.
C00021 00008 SUBR(SMOOTH,FACE,EPSILON)
C00024 00009 SUBN(MKGHOST,OLDSLAB)
C00027 00010 SUBN(DPYF,FACE)
C00030 00011 SUBN(VMATE)
C00032 00012 SUBN(RESURRECT)
C00036 00013 SUBN(GLUEVV,VERT1,VERT2)
C00041 ENDMK
C⊗;
TITLE REFACE
COMMENT ⊗------------------------------------------------------------
REFACE resurfaces a polyhedron by cutting it into slabs,
simplifing the slabs, and then glueing the slabs back together. The
process destroys the orginal polyhedron a slab at a time.
The two main intermediate data structures are the set of pieces
remaining of the original body after each slice, BSET1; and the set
of cross sectional face lamina bodies that are generated, BSET2. As
the process runs, BSET1 decreases from the given polyhedron to null,
and BSET2 increases from null into the new smoothed resurfce body.
Naturally there are wheels within wheels: the outmost loop is
in REFACE which cycles from ZMIN to ZMAX making SLABs. The next
significant loop is in SLICE0 which first cycles thru the set of body
pieces marking vertices (using VMARK) and collecting a list of lists
of edges (using FECUT); next SLICE0 cycles thru the list of lists
removing the very short edges (created by FECUT) which results in
UNGLUEing the two sides of a slice, leaving to fresh slice faces, the
upper one of which is then cons'ed into the list FSET1.
--------------------------------------------------------------------⊗
EXTERN ESPLIT,INVERT,OTHER,VCCW,MKFE,ECCW,KLFE,GEODPY
EXTERN BGET,BATT,KLBFEV,MKCOPY,MKCUBE,TRANSL,MKB,KLEV
EXTERN FCW,FCCW,FACOEF
↓PZ ← 1B28
↓NZ ← 1B29
↓WASP ← 1B5
;--------------------------------------------------------------------
ZCUT: 0 ;CURRENT ZCUT LEVEL.
ZDELTA: 0 ;ZCUT INTERVAL.
BSET1: 0 ;SET OF ORIGINAL BODIES.
BSET2: 0 ;SET OF RESULTING BODIES.
FSET1: 0 ;SET OF ORIGINAL SLICE FACES (PZ) OM CAR8,,CDR8.
ELIST1: 0 ;LIST OF VERY SHORT EDGES IN ALT LINKS.
ELIST2: 0 ;LIST OF LAST SHORT EDGES IN ALT2 LINKS.
DECLARE{XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX}
BUFFER: BLOCK 1000
CFLIST: 0 ;SMOOTHED CUT FACE LAMINA LIST - ALT LINK OF FACES.
VLIST: 0 ;VERTICES OF SMOOTH CUT FACE LAMINA OF A SLAB.
SUBR(REFACE,BODY,NUMBER) ;MAKE N CUTS ALONG Z AXIS.
;--------------------------------------------------------------------
;INITIALIZE BSET1 AND BSET2.
SETQ(BSET1,{MKB,[0]}) ;ORIGINAL BODY (AND ITS PIECES).
CALL(BATT,BODY,BSET1)
SETQ(BSET2,{BOUNDS,BODY}) ;RESULTING BODIES.
;Z SECTION WIDTH.
LAC 0,ZMAX↔LAC 1,ZMIN↔FSBR 0,1↔DAC 1,ZCUT
LAC 1,NUMBER↔DACN 1,COUNT#↔AOS 1
FSC 1,233↔FDVR 0,1↔DAC 0,ZDELTA
;LOOP FOR CUTTING CROSS SECTIONS.
L1: LAC ZDELTA↔FADRM ZCUT
CALL(SLICE0,BSET1) ;MAKE SLICE AT ZCUT.
CALL(KLNBDY) ;KILL PIECES BELOW SLICE LEVEL.
; CALL(GEODPY)
AOSGE COUNT↔GO L1
CALL(KLBFEV,BSET1)
CALL(KLBFEV,BSET2)
LAC 1,SLAB2↔POP2J
ENDR REFACE;1/15/74(BGB)---------------------------------------------
SUBN(KLNBDY) ;KILL NEGATIVE BODIES OF THE FSET1 LIST.
;--------------------------------------------------------------------
ACCUMULATORS{F}
;GET NEGATIVE CUT FACE AND TEST FOR ITS EXISTENCE.
LAC 1,FSET1
L1: DAC 1,F1#↔HLRE 1,6(1) ;SIGNED ALT LINK. -1 DEAD CUT FACE.
JUMPLE 1,L2
PED 1,1↔CCW 1,1↔DAC 1,SLAB1 ;BODY FETCH THE OLD SLAB.
;KILL AND RESURRECT THE SLAB BODY.
CALL(MKGHOST,SLAB1) ;MAKE GHOST OF THE SLAB.
; CALL(VMATE) ;FIND CLOSET NEIGHBORING VERTEX.
CALL(DPYALL)
; SETQ(SLAB2,{RESURRECT}) ;TURN THE GHOST INTO A NEW BODY.
CALL(KLBFEV,SLAB1) ;KILL A NEGATIVE SLAB BODY.
L2: LAC 1,F1↔CDR 1,8(1) ;ADVANCE DOWN CUT FACE LIST.
JUMPN 1,L1↔POP0J ;EXIT.
ENDR KLNBDY;1/15/74(BGB)---------------------------------------------
DECLARE{SLAB1,SLAB2}
SUBN(BOUNDS,BODY) ;MAKE BOUNDS CUBE.
;--------------------------------------------------------------------
ACCUMULATORS{B,V,XLO,XHI,YLO,YHI,ZLO,ZHI}
;FIND COORDINATE EXTREMA.
HRLOI XLO,377777↔HRLZI 400000
HRLOI YLO,377777↔HRLZI 400000
HRLOI ZLO,377777↔HRLZI 400000
LAC B,BODY↔LAC V,B
L1: PVT V,V↔CAMN V,B↔GO L2
CAMLE XLO,XWC(V)↔LAC XLO,XWC(V)↔CAMGE XHI,XWC(V)↔LAC XHI,XWC(V)
CAMLE YLO,YWC(V)↔LAC YLO,YWC(V)↔CAMGE YHI,YWC(V)↔LAC YHI,YWC(V)
CAMLE ZLO,ZWC(V)↔LAC ZLO,ZWC(V)↔CAMGE ZHI,ZWC(V)↔LAC ZHI,ZWC(V)
GO L1
;MAKE BOUNDS CUBE AND TRANSLATE IT TO PROPER POSITION.
L2: DAC XLO,XMIN↔DAC XHI,XMAX
DAC YLO,YMIN↔DAC YHI,YMAX
DAC ZLO,ZMIN↔DAC ZHI,ZMAX
FSBR XHI,XLO↔FADR XLO,XMAX↔FSC XLO,-1↔PUSH P,XLO
FSBR YHI,YLO↔FADR YLO,YMAX↔FSC YLO,-1↔PUSH P,YLO
FSBR ZHI,ZLO↔FADR ZLO,ZMAX↔FSC ZLO,-1↔PUSH P,ZLO
SETQ(BSET2,{MKCUBE,XHI,YHI,ZHI})
POP P,ZLO↔POP P,YLO↔POP P,XLO
CALL(TRANSLATE,BSET2,XLO,YLO,ZLO)
LAC 1,BSET2↔POP1J
ENDR BOUNDS;1/15/74(BGB)---------------------------------------------
SUBR(SLICE0,BDYSET) ;SLICE A SET OF BODIES AT ZCUT LEVEL.
;--------------------------------------------------------------------
;INITIALIZATION.
DZM ELIST2 ;LIST OF LISTS OF SHORT EDGES.
DZM FSET1 ;LIST OF PZ SLICE FACES.
;LOOP FOR CUTTING BODIES OF THE BODY SET.
LAC 1,BDYSET↔SON 1,1↔DAC 1,B0↔DAC 1,B ;INIT THE LOOP.
L1: CALL(VMARK,B) ;MARK VERTICES PZ & NZ.
SKIPN PZCNT↔GO .+3 ;PIECE FULLY BELOW.
SKIPE NZCNT↔GO[CALL(FECUT,B)↔GO .+1] ;CUT FACES AND EDGES.
LAC 1,B↔BRO 2,1↔DAC 2,B ;ADVANCE ALONG BODY RING.
SKIPN PZCNT↔GO[CALL(KLBFEV,1)↔GO .+1] ;KILL PIECE FULLY BELOW.
LAC 1,B↔CAME 1,B0↔GO L1 ;...AND FALL THRU.
;--------------------------------------------------------------------
;SLICE THE SOLID - MAPCAR UNGLUE DOWN THE ALT2 EDGE LIST 2.
L2: SKIPN 2,ELIST2↔GO L5
ALT2 1,2↔DAC 1,ELIST2
DAC 2,ELIST1
;KILL THE TIES THAT BIND - MAPCAR KLFE DOWN THE ALT EDGE LIST 1.
L3: SKIPN 2,ELIST1↔GO L4
ALT 1,2↔DAC 1,ELIST1
PFACE 0,2↔DAC 0,FACE1
SETQ(FACE2,{KLFE,2})↔GO L3
;PLACE THE NEW FACES OF THE SLICE INTO A RING.
L4: LAC 1,FACE1↔LAC 2,FACE2
ALT. 1,2↔ALT. 2,1 ;TWO NEW FACES.
TEST 1,PZ↔EXCH 1,2
LAC 4,FSET1↔DAP 4,8(1)↔DAC 1,FSET1 ;CDR8 LINK.
GO L2
;--------------------------------------------------------------------
;UPDATE SET OF POSITIVE BODIES IN BSET1.
L5: LAC 1,FSET1↔DAC 1,FACE1
L6: PED 1,1↔CCW 1,1↔CALL(BATT,1,BSET1)
LAC 1,FACE1↔CDR 1,8(1)↔DAC 1,FACE1 ;ADVANCE CUT-FACE RING.
JUMPN 1,L6↔LAC 1,FSET1↔POP1J
DECLARE{EDGE,FACE1,FACE2,B,B0}
ENDR SLICE0;1/12/74(BGB)---------------------------------------------
SUBN(VMARK,BODY) ;MARK THE VERTICES OF A BODY AS PZ OR NZ.
;--------------------------------------------------------------------
ACCUMULATORS{V,PDEL,NDEL,E,E0}
;CLEAR THE NZ AND PZ BITS OF ALL THE EDGES AND VERTICES.
DZM PZCNT↔DZM NZCNT
LACI PZ+NZ↔LAC 1,BODY
ANDCAM(1)↔PVT 1,1↔CAME 1,BODY↔GO .-3
ANDCAM(1)↔PED 1,1↔CAME 1,BODY↔GO .-3
;POSITIVE AND NEGATIVE EPSILON.
LAC PDEL,ZCUT↔FADR PDEL,[0.01]
LAC NDEL,ZCUT↔FSBR NDEL,[0.01]
;FORCE THE VERTICES TO BE ABOVE OR BELOW THE SLICE PLANE.
LAC V,BODY
L1: PVT V,V↔CAMN V,BODY↔POP1J
L2: LAC ZWC(V)
CAML PDEL↔GO[MARK V,PZ↔AOS PZCNT↔GO L3]
CAMG NDEL↔GO[MARK V,NZ↔AOS NZCNT↔GO L3]
FSBR ZCUT
SKIPL ↔DAC PDEL,ZWC(V)
SKIPGE↔DAC NDEL,ZWC(V)↔GO L2
;MARK THE EDGES OF THIS VERTEX AS PZ OR NZ.
L3: PED E,V↔LAC E0,E
L4: PVT 1,E↔CAME 1,V↔GO .+3↔PCW 1,E↔GO L5 ;AC1 ← ECCW(E,V).
NVT 1,E↔CAME 1,V↔GO L1 ↔NCW 1,E
L5: IORM 0,(E)↔LAC E,1 ;AC0 CONTAINS THE BIT.
CAME E,E0↔GO L4↔GO L1
ENDR VMARK;1/11/74(BGB)---------------------------------------------
DECLARE{PZCNT,NZCNT}
SUBN(FECUT,BODY) ;FACE EDGE CUTTING.
;--------------------------------------------------------------------
ACCUMULATORS{V2,V1,DX,DY,DZ}
;SCAN THE EDGES OF THE BODY FOR ZCUT CROSSINGS.
LAC 1,BODY↔DAC 1,EDGE#
L0: LAC 1,EDGE↔NED 1,1↔DAC 1,EDGE ;ADVANCE ALONG EDGE RING.
CAMN 1,BODY↔POP1J ;TEST FOR END OF EDGE RING.
TEST 1,PZ↔GO L0 ;TEST FOR EDGE CROSSING.
TEST 1,NZ↔GO L0
;INITIALIZATION FOR FACE-EDGE CUT FOR A SINGLE SLICE FACE.
DOM FLAG ;FIRST TIME THRU FLAG -1.
DZM ELIST1 ;LIST OF VERY SHORT EDGES.
LAC 1,EDGE
DAC 1,E↔NVT 2,1↔TEST 2,PZ
GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZ HALF-SPACE.
LAC 1,E↔NFACE 1,1
DAC 1,F0↔DAC 1,F ;FIRST FACE.
;SPLIT EDGE - SO THAT PVT(E) IS IN NZ HALF SPACE.
L1: LAC 1,E↔MARKZ 1,PZ+NZ
NVT V1,1↔PVT V2,1↔PUSH P,V2↔PUSH P,V1 ;SAVE OLDE VERTICES.
TEST V1,PZ↔GO[CALL(INVERT,E)↔GO .+1] ;FORCE NVT(E) INTO PZZ.
SETQ(U2,{ESPLIT,E})↔MARK 1,PZ ;PZ HALFSPACE.
PED 1,1
LAC 2,ELIST1↔ALT. 2,1↔DAC 1,ELIST1 ;CONS EDGE INTO ELIST1.
SETQ(UU2,{ESPLIT,ELIST1})↔MARK 1,NZ ;NZ HALFSPACE.
;COMPUTE LOCUS WHERE E INTERSECTS THE SLICE PLANE.
POP P,V1↔POP P,V2 ;RESTORE OLDE VERTICES.
LAC DX,XWC(V2)↔FSBR DX,XWC(V1)
LAC DY,YWC(V2)↔FSBR DY,YWC(V1)
LAC DZ,ZWC(V2)↔FSBR DZ,ZWC(V1)
LAC ZCUT↔FSBR ZWC(V1)↔FDVR DZ↔LAC 2,U2 ;COEFFICIENT K.
FMPR DX,0↔FADR DX,XWC(V1)↔DAC DX,XWC(1)↔DAC DX,XWC(2)
FMPR DY,0↔FADR DY,YWC(V1)↔DAC DY,YWC(1)↔DAC DY,YWC(2)
FMPR DZ,0↔FADR DZ,ZWC(V1)↔DAC DZ,ZWC(1)↔DAC DZ,ZWC(2)
;FIRST TIME ONLY.
AOSG FLAG↔GO[LAC U2↔DAC U0
LAC UU2↔DAC UU0↔GO L2]
;DOUBLE FACE SPLIT.
CALL(MKFE,U2,F,U1)↔NFACE 1,1
CALL(MKFE,UU2,1,UU1)
;ADVANCE INTO THE NEXT FACE & FIND NEXT CROSSING EDGE.
L2: LAC U2↔DAC U1↔LAC UU2↔DAC UU1
SETQ(F,{OTHER,E,F})
CAMN 1,F0↔GO L4
L3: SETQ(E,{ECCW,E,F})
TEST 1,NZ↔GO L3↔GO L1
;DOUBLE CUT LAST (FIRST) FACE.
L4: CALL(MKFE,U0,F,U1)↔NFACE 1,1
CALL(MKFE,UU0,1,UU1)
;CONS ELIST1 INTO ELIST
LAC 1,ELIST1↔LAC 2,ELIST2
ALT2. 2,1↔DAC 1,ELIST2↔GO L0
DECLARE{F,E,U0,U1,U2,F0,FLAG,UU0,UU1,UU2}
ENDR FECUT;1/11/74(BGB)---------------------------------------------
SUBR(SMOOTH,FACE,EPSILON)
LAC 1,FACE↔PED 1,1
DAC 1,EDGE0↔DAC 1,EDGE↔SETZ 4,
L0: SETQ(EDGE,{ECCW,EDGE,FACE})
CAME 1,EDGE0↔AOJA 4,L0
SUBI 4,3↔DAC 4,CNT
LAC 1,FACE↔PED 1,1
DAC 1,EDGE↔GO L2
L1: SETQ(VERTEX,{VCCW,EDGE,FACE})
CALL(VTEST,VERTEX)
MOVMS 1↔CAMG 1,EPSILON↔GO L2
SOSGE CNT↔POP2J
SETQ(EDGE,{KLEV,VERTEX})↔GO L3
L2: SETQ(EDGE,{ECCW,EDGE,FACE})
L3: LAC 2,FACE↔PED 0,2
CAME 0,1↔GO L1
SETQ(VERTEX,{VCCW,EDGE,FACE})
CALL(VTEST,VERTEX)
MOVMS 1↔CAMG 1,EPSILON↔POP2J
SETQ(EDGE,{KLEV,VERTEX})↔POP2J
DECLARE{EDGE,VERTEX,CNT,EDGE0}
ENDR SMOOTH;---------------------------------------------------------
SUBN(EDGCOE,EDGE) ;EDGE COEFFICIENTS FROM XWC,YWC.
ACCUMULATORS{E,S,V1,V2}
LAC E,EDGE↔NVT V1,E↔PVT V2,E
LAC YWC(V2)↔FSBR YWC(V1)↔DAC AA(E)↔FMPR↔DAC 1
LAC XWC(V1)↔FSBR XWC(V2)↔DAC BB(E)↔FMPR↔FADR 1,0
LAC XWC(V2)↔FMPR YWC(V1)
LAC S,XWC(V1)↔FMPR S,YWC(V2)↔FSBR S↔DAC CC(E)
CALL(SQRT↑,1)↔DAC 1,8(E)↔SLACI(<1.0>)↔FDVR 0,1
FMPRM AA(E)↔FMPRM BB(E)↔FMPRM CC(E)
POP1J
ENDR EDGCOE;7/23/73(BGB)--------------------------------------------
SUBN(QCROSS,EDGE1,EDGE2)
ACCUMULATORS{E1,E2}
LAC E1,EDGE1
LAC E2,EDGE2
LAC 0,AA(E1)↔FMPR 0,AA(E2)
LAC 1,BB(E1)↔FMPR 1,BB(E2)↔FADR 1,0
POP2J
ENDR QCROSS;---------------------------------------------------------
SUBN(VTEST,VERT)
LAC 1,VERT↔PED 2,1↔DAC 2,E1
SETQ(E2,{ECCW,E1,VERT})
CALL(EDGCOE,E1)
CALL(EDGCOE,E2)
LAC 1,[1.0]↔LAC 0,[0.01]
LAC 2,E1↔CAMLE 0,8(2)↔POP1J ;EDGE LENGTH TOO SHORT.
LAC 2,E2↔CAMLE 0,8(2)↔POP1J
CALL(QCROSS,E1,E2)↔POP1J ;ANGLE TOO SHARP OR SMOOTH.
DECLARE{E1,E2}
ENDR VTEST;----------------------------------------------------------
SUBN(MKGHOST,OLDSLAB)
;--------------------------------------------------------------------
ACCUMULATORS{Q,F,V,E,E0,PTR}
;INITIALIZE TWO LISTS.
LAC F,OLDSLAB ;SLAB'S FACE RING.
DZM CFLIST ;SMOOTHED CUT FACE LAMINA LIST.
LACI BUFFER↔DAC VLIST ;NEW VERTICES LIST POINTER.
;RING AROUND THE FACES OF THE OLD SLAB, WHICH IS TO BE REPLACED.
L1: NFACE F,F↔CAMN F,OLDSLAB↔POP1J
ALT Q,F↔JUMPE Q,L1↔WIP 6(Q) ;NZ-CUT FACE TEST & CLEAR.
DAC F,FACE
;COPY OLD CUT FACE INTO A CUT FACE LAMINA WHICH IS THEN SMOOTHED.
CALL(MKCOPY,FACE) ;CUT FACE LAMINA BODY.
PFACE 1,1↔DAC 1,LAMINA ;SECOND FACE OF A LAMINA IS OUTWARDS.
MARK 1,PZ ;...FOR OUTWARDS SIDE.
CALL(SMOOTH,LAMINA,[0.90])
;PUSH NEW CUT FACE LAMINA INTO THE CUT-FACE LIST.
LAC 1,LAMINA↔LAC 2,CFLIST
ALT. 2,1↔DAC 1,CFLIST
;POINTER FOR FINAL SLAB GLUEING IN RESURRECT.
LAC F,FACE↔ALT Q,F ;CUT FACE AND ITS POSSIBLE MATE.
TEST F,PZ
ALT2. 1,Q ;NZ TOP - CUT-FACE Q POINTS AT LAMINA
ALT2. F,1 ;PZ BOTTOM - LAMINA POINTS AT CUT-FACE.
;PUSH THE SURVIVING VERTICES OF THE SMOOTHED CUT-FACE-LAMINA INTO A BUFFER.
LAC F,LAMINA↔PED E,F
DAC E,E0↔LAC PTR,VLIST
L2: SETQ(V,{VCCW,E,F})↔DIP F,V↔PUSH PTR,V
SETQ(E,{ECCW,E,F})↔CAME E,E0↔GO L2
DAC PTR,VLIST↔LAC F,FACE
GO L1
DECLARE{LAMINA,FACE}
ENDR MKGHOST;--------------------------------------------------------
SUBN(DPYF,FACE)
E←←10↔E0←←11↔V←←12
LAC E,FACE↔PED E,E↔DAC E,E0
SETQ(V,{VCW↑,E0,FACE})
LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,
CALL(AIVECT↑,0,1)↔CALL(DPYBRT↑,[2])
L1: SETQ(V,{VCCW,E,FACE})
LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,↔CALL(AVECT↑,0,1,0,1)
;CLOSEST ALEIN MATE OF A VERTEX.
CCW V,V↔JUMPE V,L2↔CALL(DPYBRT↑,[5])
LAC 0,XWC(V)↔FMPR 0,SCALE↔FIXX 0,
LAC 1,YWC(V)↔FMPR 1,SCALE↔FIXX 1,↔CALL(AVECT↑,0,1)
CALL(DPYBRT↑,[2])
L2: CALL(AIVECT)
SETQ(E,{ECCW,E,FACE})
CAME E,E0↔GO L1
POP1J
SCALE: 1000.0
ENDR DPYF;-----------------------------------------------------------
SUBN(DPYALL)
LAC 1,CFLIST↔DAC 1,LIST#
CALL(DPYSET↑,DPYBUF↑)
L0: SKIPE 1,LIST↔GO L1
CALL(DPYOUT↑,[1])
INCHRW↔POP0J
L1: CALL(DPYF,LIST)
LAC 1,LIST↔ALT 1,1↔DAC 1,LIST ;ADVANCE CUT FACE LIST.
GO L0
ENDR DPYALL;---------------------------------------------------------
SUBN(DPYVV,V1,V2)
LAC[XWD 1,TMP1]↔BLT TMP1+11
CALL(GEODPY)
CALL(DPYSET↑,DPYBUF↑)
LAC 2,V1↔XDC 0,2↔YDC 1,2↔FIXX 0,↔FIXX 1,
SUBI 0,12↔SUBI 1,4
CALL(AIVECT↑,0,1)↔CALL(DTYO↑,["1"])
LAC 2,V2↔XDC 0,2↔YDC 1,2↔FIXX 0,↔FIXX 1,
SUBI 0,12↔SUBI 1,4
CALL(AIVECT↑,0,1)↔CALL(DTYO↑,["2"])
CALL(DPYOUT,[3])
LAC[XWD TMP1,1]↔BLT 1+11
POP2J
TMP1: BLOCK 17
ENDR DPYVV
SUBN(VMATE)
;MATE EACH VERTEX WITH THE CLOSEST ALEIN VERTEX IN THE CCW LINK.
ACCUMULATORS{PTR1,PTR2,V1,V2,X,Y,V,ZMIN,F}
LAC PTR1,VLIST
LACI BUFFER↔DAC EOL#
L1: CAMN PTR1,EOL↔POP0J
POP PTR1,V1 ;FOR EACH VERTEX.
CAR F,V1↔ZIP V1 ;DOMESTIC FACE.
HRLI ZMIN,377777↔DZM V ;INITIAL MINIMUM
LAC PTR2,VLIST
L2: CAMN PTR2,EOL↔GO L3↔POP PTR2,V2 ;FOR ALL THE OTHERS.
CAR 0,V2↔CAMN 0,F↔GO L2 ;TEST FOR ALEIN FACE.
LAC X,XWC(V2)↔FSB X,XWC(V1)↔FMPR X,X ;DISTANCE MEASURE.
LAC Y,YWC(V2)↔FSB Y,YWC(V1)↔FMPR Y,Y
FADR X,Y↔CAML X,ZMIN↔GO L2 ;TEST FOR MINIMUM.
DAC V2,V↔DAC X,ZMIN↔GO L2 ;NEW MINIMA V MATE.
L3: CCW. V,V1↔GO L1 ;MATE TWO VERTICES.
ENDR VMATE;1/26/74(BGB)----------------------------------------------
SUBN(RESURRECT)
ACCUMULATORS{V1,V2,E,E0,PTR,F1,F2}
;LINK EACH VERTEX WITH ITS MATE BY MEANS OF AN EDGE.
L0: DZM FLAGVV
LAC PTR,VLIST↔DAC PTR,PTRSAV#
L1: LAC PTR,PTRSAV
CAIN PTR,BUFFER↔GO L6
POP PTR,V1↔DAC PTR,PTRSAV
ZIP V1 ;CLEAR FACE HALF.
CCW V2,V1↔JUMPE V2,L1 ;IS THERE A MATE ?
CALL(LINKED↑,V1,V2)↔JUMPN 1,L1 ;COMMON EDGE ALREADY ?
CALL(GLUEVV,V1,V2)↔GO L1
;GLUE THE NEW SLAB INTO THE NEW BODY.
L6: SKIPE FLAGVV↔GO L0
LAC CFLIST↔DAC FACE#
L7: SKIPN F1,FACE↔GO L8 ;TEST FOR END OF CFLIST.
ALT F2,F1↔DAC F2,FACE ;SAVE FOR NEXT TIME.
ALT2 F2,F1
ALT2 F2,F2↔JUMPE F2,L7
CALL(GLUE↑,F1,F2)↔GO L7
L8: LAC 1,BUFFER+1
PED 1,1↔CCW 1,1 ;RETURN LATEST BODY.
POP0J
ENDR RESURRECT;1/27/74(BGB)------------------------------------------
SUBN(GLUEVV,VERT1,VERT2)
ACCUMULATORS{V1,V2,F1,F2,E,E0}
;TEST WHETHER THE VERTICES ARE ON THE SAME BODY.
LAC V1,VERT1↔PED 1,V1↔CCW 0,1 ;BGET(V1).
LAC V2,VERT2↔PED 1,V2↔CCW 1,1 ;BGET(V2).
CAME 0,1↔GO L4 ;TEST COMMON BODY ?
;FIND COMMON FACE OF V1 AND V2; AND MAKE A NEW FACE & EDGE.
PED E,V1↔DAC E,E0↔GO L3
L2: SETQ(E,{ECCW,E,V1})
CAMN E,E0↔POP2J
L3: SETQ(F1,{FCCW,E,V1})
CALL(LINKED,F1,V2)↔JUMPE 1,L2
;AVOID THE STING OF THE FUCKING WASP EDGES.
PED E,V1↔DAC E,E0
L3A: TESTZ E,WASP↔GO[SETOM FLAGVV↔POP2J]
SETQ(E,{ECCW,E,V1})↔CAME E,E0↔GO L3A
PED E,V2↔DAC E,E0
L3B: TESTZ E,WASP↔GO[SETOM FLAGVV↔POP2J]
SETQ(E,{ECCW,E,V2})↔CAME E,E0↔GO L3B
CALL(MKFE,V1,F1,V2)↔POP2J
;VERTICES HAVE DIFFERENT BODIES, GLUE EDGE.
L4: PED E,V1↔ SETQ(F1,{FCCW,E,V1})
TEST F1,PZ↔GO L5↔ SETQ(F1,{FCW,E,V1})
TESTZ F1,PZ↔HALT
L5: PED E,V2↔ SETQ(F2,{FCCW,E,V2})
TEST F2,PZ↔GO L6↔ SETQ(F2,{FCW,E,V2})
TESTZ F2,PZ↔HALT
L6: CALL(GLUEE↑,F1,V1,F2,V2)
POP2J
ENDR GLUEVV;---------------------------------------------------------
DECLARE{FLAGVV}
END